Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Snippets/PNL Libraries/MyPrinting.p

Text File | 1997-03-25 | 7KB | 243 lines

unit MyPrinting;

interface

    uses
        Printing;

    type
        PObject = object
                procedure Create;
                procedure Destroy;
                function CountPages (r: Rect): integer;
                function DrawPage (r: Rect; gp: GrafPtr; pg: integer; first, last: boolean): OSErr;
                procedure OpenPrintingStatusDialog;
                procedure DoIdle;
                procedure ClosePrintingStatusDialog;
            end;

    var
        thePrintingRecordHandle: THPrint;

    procedure StartupPrinting;
    function PrintStuff (pob: PObject; thePrRecHdl: THPrint): OSErr; { may return userCanceledErr }
    function DoPageSetup (pob: PObject; thePrRecHdl: THPrint): OSErr;

implementation

    uses
        Quickdraw, ToolUtils, Resources,
        MyCursors, MyStartup;

    procedure PObject.Create;
    begin
    end;

    procedure PObject.Destroy;
    begin
        dispose(self);
    end;

    function PObject.CountPages (r: Rect): integer;
    begin
{$unused( r )}
        CountPages := 1;
    end;

    procedure PObject.DoIdle;
    begin
    end;

    function PObject.DrawPage (r: Rect; gp: GrafPtr; pg: integer; first, last: boolean): OSErr;
    begin
{$unused( pg, first, last )}
        SetPort(gp);
        with r do
            MoveTo((left + right) div 2 - 20, (top + bottom) div 2);
        DrawString('Not Yet Implemented');
        DrawPage := noErr;
    end;

    procedure PObject.OpenPrintingStatusDialog;
    begin
        CursorSetWatch;
    end;

    procedure PObject.ClosePrintingStatusDialog;
    begin
        CursorSetArrow;
    end;

    var
        gpob: PObject;

    procedure DoIdle;
    begin
        gpob.DoIdle;
    end;

    function DoPageSetup (pob: PObject; thePrRecHdl: THPrint): OSErr;
        var
            dummy: boolean;
    begin
{$unused( pob )}
        PrOpen;
        if PrError = noErr then begin
            dummy := PrStlDialog(thePrRecHdl);
            DoPageSetup := noErr;
        end
        else begin
            DoPageSetup := PrError;
        end;
        PrClose;
    end;

{*------ PrintStuff ---------------------------------------------------------*}
{** **   PrintStuff will call all of the necessary Print Manager calls to print }
{**   a document.  It checks PrError() after each Print Manager call.  If an }
{ **   error is found, all of the Print Manager open calls (i.e., PrOpen, }
{ **   PrOpenDoc...) will have a corresponding close call before the error }
{ **   is posted to the user.  You want to use this approach to make sure the }
{ **   Print Manager closes properly and all temporary memory is released. }
    function PrintStuff (pob: PObject; thePrRecHdl: THPrint): OSErr;

        var
            copies, firstPage, lastPage, numberOfCopies, pageNumber, printmgrsResFile, realNumberOfPagesInDoc: Integer;
            oldPort: GrafPtr;
            thePrPort: TPPrPort;
            theStatus: TPrStatus;
            err: OSErr;
    begin
        GetPort(oldPort);
        gpob := pob;

        PrOpen;
        if PrError = noErr then begin
             { Save the current resource file (i.e. the printer driver's) so the driver will not lose its }
            { resources upon return from the pIdleProc.}
            printmgrsResFile := CurResFile;

            realNumberOfPagesInDoc := pob.CountPages(thePrRecHdl^^.prInfo.rPage);

            if PrJobDialog(thePrRecHdl) then begin
 {                          Get the number of copies of the document that}
 {                          the user wants printed from iCopies of the TPrJob}
  {                         record (IM II-151).}

                numberOfCopies := thePrRecHdl^^.prJob.iCopies;

  {                           Get the first and last pages of the document that}
  {                          were requested to be printed by the user from}
   {                         iFstPage and iLastPage from the TPrJob record}
   {                         (IM II-151).}

                firstPage := thePrRecHdl^^.prJob.iFstPage;
                lastPage := thePrRecHdl^^.prJob.iLstPage;

{                             Print "all" pages in the print loop}

                thePrRecHdl^^.prJob.iFstPage := 1;
                thePrRecHdl^^.prJob.iLstPage := 9999;
                if (lastPage > realNumberOfPagesInDoc) then begin
                    lastPage := realNumberOfPagesInDoc;
                end;

  {                           Print the number of copies of the document}
 {                           requested by the user from the Print Job Dialog.}
                pob.OpenPrintingStatusDialog;

                for copies := 1 to numberOfCopies do begin
 {                               Install and call your "Print Status Dialog".}
                    thePrRecHdl^^.prJob.pIdleProc := @DoIdle;

                    UseResFile(printmgrsResFile);

                    thePrPort := PrOpenDoc(thePrRecHdl, nil, nil);

                    if (PrError = noErr) then begin
                            {  Print the range of pages of the document requested by the user from the Print Job Dialog.}

                        pageNumber := firstPage;
                        while ((pageNumber <= lastPage) and (PrError = noErr)) do begin

                            PrOpenPage(thePrPort, nil);

                            if (PrError = noErr) then begin
                                { rPage (IM II-150) is the printable area for the currently selected printer. By passing the current}
                              { enables your app to use the same routine to draw to the screen and the printer's GrafPort.}

                                err := pob.DrawPage(thePrRecHdl^^.prInfo.rPage, GrafPtr(thePrPort), pageNumber, firstPage = pageNumber, lastPage = pageNumber);
                                if err <> noErr then begin
                                    PrSetError(err);
                                end;
                            end;
                            PrClosePage(thePrPort);
                            pageNumber := pageNumber + 1;
                        end;  {**  End pagenumber loop  **}
                    end;
                    PrCloseDoc(thePrPort);
                end;  {**  End copies loop  **}

                pob.ClosePrintingStatusDialog;
  {                            The printing job is being canceled by the request}
  {                            of the user from the Print Style Dialog or the}
  {                            Print Job Dialog PrError will be set to iPrAbort}
   {                           to tell the Print Manager to abort the current}
   {                           printing job.}
            end
            else begin
                PrSetError(iPrAbort); {** Cancel from the job dialog **}
            end;
        end;
        if (thePrRecHdl^^.prJob.bJDocLoop = bSpoolLoop) and (PrError = noErr) then begin
            PrPicFile(thePrRecHdl, nil, nil, nil, theStatus);
        end;

  {        Grab the printing error before you close}
 {        the Print Manager and the error disappears.}

        if PrError = iPrAbort then begin
            PrintStuff := userCanceledErr;
        end
        else begin
            PrintStuff := PrError;
        end;

        PrClose;

        SetPort(oldPort);
    end;  {**  PrintStuff  **}

    function InitPrinting(var msg: integer): OSStatus;
    begin
{$unused(msg)}
        thePrintingRecordHandle := THPrint(NewHandle(SIZEOF(TPrint)));
        PrOpen;
        if PrError = noErr then begin
            PrintDefault(thePrintingRecordHandle);
            PrClose;
        end;
        InitPrinting := noErr;
    end;

    procedure FinishPrinting;
    begin
        DisposeHandle(Handle(thePrintingRecordHandle));
    end;

    procedure StartupPrinting;
    begin
        StartupCursors;
        SetStartup(InitPrinting, nil, 0, FinishPrinting);
    end;

end.
procedure PObject.PostPrintingErrors (oe: OSErr);
    var
        s: Str255;
        a: integer;
begin
    NumToString(oe, s);
    ParamText('Print Error = ', s, '', '');
    a := Alert(fail_alert_id, nil);
end;